VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsStatusFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Option Explicit
'Public Function ValidateXmlFormat(strErrMsg As String) As Boolean
'
'    Dim xmldoc As MSXML2.DOMDocument40
'    Dim strXML As String
'
'    On Error GoTo ValidateXmlFormatFix
'
'    Set xmldoc = New MSXML2.DOMDocument40
'    strXML = IdxVars.XmlString
'
'    'Validation XML Document
'    'i.e. load the source XML file into an MSXML DOMDocument object
'    xmldoc.async = False
'    'If Not XMLDoc.Load("C:\Projects\KeyTax\Xml\XmlDocs\FormB_Request.xml") Then
'    If Not xmldoc.loadXML(strXML) Then
'        xmldoc.validateOnParse = True
'        strErrMsg = strErrMsg & "Error Code:" & xmldoc.parseError.errorCode & vbCrLf
'        strErrMsg = strErrMsg & "Error Reason:" & xmldoc.parseError.reason & vbCrLf
'        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.srcText & vbCrLf
'        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.Line & vbCrLf
'
'        'barb:call fileerror.dll
'
'        ValidateXmlFormat = False
'    Else
'        ValidateXmlFormat = True
'    End If
'
'    Exit Function
'
'ValidateXmlFormatFix:
'    MsgBox "ValidateXmlFormat: " & Err.Number & " - " & Err.Description
'    ValidateXmlFormat = False
'End Function
'
'Public Function ExtractIndexBlobFromDb(lngInterfaceNo As Long) As Boolean
'
'
'    Dim rsBlob As ADODB.Recordset
'     Dim arrBlob() As Byte
'     Dim iFree As Integer
'     Dim lngBlobLen As Long
'     Dim lngRemainder As Long
'     Dim lngNumOfSections As Long
'     Dim strSql As String
'     Dim BlobHolder As Variant
'     Dim i As Integer
'     Dim strHolder As String
'
'     Const SEGMENT_LENGTH As Long = 4096
'
'    On Error GoTo ExtractIndexBlobFromDbFix
'
'     iFree = FreeFile
'     'initilize the recordset
'     Set rsBlob = New ADODB.Recordset
'     rsBlob.CursorType = adOpenKeyset
'     rsBlob.LockType = adLockOptimistic
'
'    strSql = "Select * from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
'    strSql = strSql & " where I.INTERFACE_NO = X.INTERFACE_NO"
'    strSql = strSql & " and I.INTERFACE_NO = " & lngInterfaceNo
'    strSql = strSql & " and MQ_STATUS = '04'" 'Processed - changed to this by Receive XML (MQ_STATUS)
'    Set rsBlob = adoConn.Execute(strSql)
'
'
'     If rsBlob.BOF = True And rsBlob.EOF = True Then
'         MsgBox "Nothing to process"
'         ExtractIndexBlobFromDb = False
'         Exit Function
'    Else
'        ExtractIndexBlobFromDb = True
'     End If
'     rsBlob.MoveFirst
'
'     'barb: get idx vars here
'     IdxVars.InterfaceNo = lngInterfaceNo
'     IdxVars.Tracking.MsgId = NullOrValue(rsBlob!MESSAGE_ID)
'     IdxVars.Tracking.ComId = NullOrValue(rsBlob!COM_ID)
'     IdxVars.Tracking.BuId = NullOrValue(rsBlob!BU_ID)
'     IdxVars.Tracking.ReferenceId = NullOrValue(rsBlob!REFERENCE_ID)
'     'IdxVars.Tracking.ReqSeqNum = NullOrValue(rsBlob!REQ_SEQ_NUM)
'     'Get current status
'
'     IdxVars.KeyTaxType = NullOrValue(rsBlob!KEYTAX_TYPE)
'     IdxVars.MqStatus = NullOrValue(rsBlob!MQ_STATUS)
'     IdxVars.CreatedDated = NullOrValue(rsBlob!CREATED_DATE)
'     IdxVars.Tracking.ReqSeqNum = NullOrValue(rsBlob!REQ_SEQ_NUM)
'
'     'get the length of the blob
'     lngBlobLen = rsBlob!XML_STRING.ActualSize
'
'     'get the number of sections that will be the number of elements in the sections array
'     lngNumOfSections = lngBlobLen \ SEGMENT_LENGTH
'
'     'get the leftover bytes that aren't divisible by the section_length
'     lngRemainder = lngBlobLen Mod SEGMENT_LENGTH
'
'     If lngRemainder <> 0 Then 'add the remaider
'         'arrBlob = rsBlob(2).GetChunk(lngRemainder)
'         arrBlob = rsBlob!XML_STRING.GetChunk(lngRemainder)
'     End If
'
'    strHolder = CStr(arrBlob)
'
'    'loop for the rest
'    For i = 1 To lngNumOfSections
'        'arrBlob = rsBlob(0).GetChunk(SEGMENT_LENGTH)
'        arrBlob = rsBlob!XML_STRING.GetChunk(SEGMENT_LENGTH)
'        'strTemp = strTemp & CStr(arrBlob(i - 1))
'        strHolder = strHolder & CStr(arrBlob)
'    Next
'
''     For i = 0 To UBound(arrBlob)
''         strHolder = strHolder & Chr(arrBlob(i))
''     Next
'
''     strXmlString = strHolder
'     IdxVars.XmlString = strHolder
'
'
'     rsBlob.Close
'
'    Exit Function
'ExtractIndexBlobFromDbFix:
'    ExtractIndexBlobFromDb = False
'    MsgBox "ExtractIndexBlobFromDb: " & Err.Number & " - " & Err.Description
'End Function
'
'Public Function GetHeaderData() As Boolean
'
'    '   This function reads the xml string and extracts the values required to update and insert into the
'    '   DIR_INTERFACE_INDEX table and puts them into the public IdxVars type
'
'    'XML Objects
'    Dim xmldoc As MSXML2.DOMDocument40
'    Dim nlKeytax As MSXML2.IXMLDOMNodeList
'    Dim elKeyTax As MSXML2.IXMLDOMElement
'    Dim nlTracking As MSXML2.IXMLDOMNodeList
'    Dim elTracking As MSXML2.IXMLDOMElement
'
'    'Other
'    Dim i As Integer
'    Dim strErrMsg As String
'    Dim strXmlString As String
'
'    On Error GoTo GetHeaderDataFix
'
'    Set xmldoc = New MSXML2.DOMDocument40
'    'Get Data
'    'XMLDoc.Load ("C:\Shane\Projects\LCB\FormB\FormB_Request.xml")
'    xmldoc.loadXML (IdxVars.XmlString)
'
'    'barb: start here
'    Set nlKeytax = xmldoc.selectNodes("/KeyTax")
'    Set elKeyTax = nlKeytax.Item(0)
'    IdxVars.KeyTaxType = elKeyTax.getAttribute("Type")
'
'    Set nlTracking = xmldoc.selectNodes("/KeyTax/Requestor/*")
'
'    For i = 0 To nlTracking.length - 1
'        Set elTracking = nlTracking.Item(i)
'        Select Case elTracking.nodeName
'                Case "Date"
'                    IdxVars.Request.Date = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                Case "Time"
'                    IdxVars.Request.Time = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                Case "Name"
'                    IdxVars.Request.Name = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                Case "UserID"
'                    IdxVars.Request.UserId = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                Case "email"
'                    IdxVars.Request.Email = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'        End Select
'    Next i
'
'
'    Set nlTracking = xmldoc.selectNodes("/KeyTax/Tracking/*")
'
'    For i = 0 To nlTracking.length - 1
'        Set elTracking = nlTracking.Item(i)
'        Select Case elTracking.nodeName
'                Case "RequestStatus"
'                    If Len(Trim(IdxVars.Tracking.RequestStatus)) = 0 Then
'                        IdxVars.Tracking.RequestStatus = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                    End If
'                Case "Company"
'                    If Len(Trim(IdxVars.Tracking.ComId)) = 0 Then
'                        IdxVars.Tracking.ComId = NullOrValue(elTracking.getAttribute("ID"))
'                    End If
'                Case "BusinessUnit"
'                    If Len(Trim(IdxVars.Tracking.BuId)) = 0 Then
'                        IdxVars.Tracking.BuId = NullOrValue(elTracking.getAttribute("ID"))
'                    End If
'                Case "Message"
'                    If Len(Trim(IdxVars.Tracking.MsgId)) = 0 Then
'                        IdxVars.Tracking.MsgId = NullOrValue(elTracking.getAttribute("ID"))
'                    End If
'                Case "Reference"
'                    If Len(Trim(IdxVars.Tracking.ReferenceId)) = 0 Then
'                        IdxVars.Tracking.ReferenceId = NullOrValue(elTracking.getAttribute("ID"))
'                    End If
'                Case "KeytaxRequestNumber"
'                    If Len(Trim(IdxVars.Tracking.ReqSeqNum)) = 0 Then
'                        IdxVars.Tracking.ReqSeqNum = NullOrValue(nlTracking.Item(i).nodeTypedValue)
'                    End If
'
'        End Select
'    Next i
'
'
'
'    GetHeaderData = True
'
'Exit Function
'
'GetHeaderDataFix:
'    GetHeaderData = False
'    MsgBox "GetHeaderData: " & Err.Number & " - " & Err.Description
'End Function
'
'Private Function NullOrValue(varValue As Variant) As String
'
'    If Not IsNull(varValue) Then
'        If Len(Trim(varValue)) <> 0 Then
'           NullOrValue = varValue
'        Else
'            NullOrValue = "NULL"
'        End If
'    Else
'        NullOrValue = "NULL"
'    End If
'
'End Function
'Public Function ValidateHeaderData(strErr As String) As Boolean
'
'    Dim strSql As String
'    Dim rsIndex As ADODB.Recordset
'
'    On Error GoTo ValidateHeaderDataFix
'
'
''     'initilize the recordset
'     Set rsIndex = New ADODB.Recordset
'     rsIndex.CursorType = adOpenKeyset
'     rsIndex.LockType = adLockOptimistic
'
'    '***************Index Vars****************
'    'InterfaceNo
'    If IdxVars.InterfaceNo = 0 Then
'        strErr = strErr & "Invalid Interface number: " & IdxVars.InterfaceNo & vbCrLf
'    ElseIf Len(Trim(IdxVars.InterfaceNo)) = 0 Then
'        strErr = strErr & "Invalid Interface number: " & IdxVars.InterfaceNo & vbCrLf
'    End If
'
'     'xml string
'    If Len(Trim(IdxVars.XmlString)) = 0 Then
'        strErr = strErr & "Invalid XML string: " & IdxVars.XmlString & vbCrLf
'    End If
'
'    'CreatedDate
'    If Len(Trim(IdxVars.CreatedDated)) = 0 Then
'        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
'    ElseIf Trim(IdxVars.CreatedDated) = "NULL" Then
'        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
'    End If
''   IsDate doesn't work with "YYYYMMDD"
''    If Not IsDate(IdxVars.CreatedDated) Then
''        strErr = strErr & "Invalid CreatedDated: " & IdxVars.CreatedDated & vbCrLf
''    End If
'
'    'IdxVars.SarsResponseYn = ""        'Allowed to be empty
'
'    'KeyTaxType (DIR_SYSTEM_CODES.XML_TYPE)
'    If Len(Trim(IdxVars.KeyTaxType)) = 0 Then
'        strErr = strErr & "Invalid KeyTaxType: " & IdxVars.KeyTaxType & vbCrLf
'    ElseIf Trim(IdxVars.KeyTaxType) = "NULL" Then
'        strErr = strErr & "Invalid KeyTaxType: " & IdxVars.KeyTaxType & vbCrLf
'    Else
'        strSql = "select VALUE from DIR_SYSTEM_CODES where CODE = 'XML_TYPE' and VALUE = '" & IdxVars.KeyTaxType & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid KeyTaxType (DIR_SYSTEM_CODES.XML_TYPE): " & IdxVars.KeyTaxType & vbCrLf
'        End If
'    End If
'
'    'MqStatus (DIR_SYSTEM_CODES.MQ_STATUS)
'    If Len(Trim(IdxVars.MqStatus)) = 0 Then
'        strErr = strErr & "Invalid MqStatus: " & IdxVars.KeyTaxType & vbCrLf
'    ElseIf Trim(IdxVars.MqStatus) = "NULL" Then
'        strErr = strErr & "Invalid MqStatus: " & IdxVars.KeyTaxType & vbCrLf
'    Else
'        strSql = "select VALUE from DIR_SYSTEM_CODES where CODE = 'MQ_STATUS' and VALUE = '" & IdxVars.MqStatus & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid MqStatus (DIR_SYSTEM_CODES.MQ_STATUS): " & IdxVars.MqStatus & vbCrLf
'        End If
'    End If
'    '*************Tracking Vars*****************
'    'MsgId
'    If Len(Trim(IdxVars.Tracking.MsgId)) = 0 Then
'        strErr = strErr & "Invalid MsgId: " & IdxVars.Tracking.MsgId & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.MsgId) = "NULL" Then
'        strErr = strErr & "Invalid MsgId: " & IdxVars.Tracking.MsgId & vbCrLf
'    End If
'
'    'ComId  (DIR_COMPANIES.COM_ID)
'    If Len(Trim(IdxVars.Tracking.ComId)) = 0 Then
'        strErr = strErr & "Invalid ComId: " & IdxVars.Tracking.ComId & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.ComId) = "NULL" Then
'        strErr = strErr & "Invalid ComId: " & IdxVars.Tracking.ComId & vbCrLf
'    Else
'        strSql = "Select COM_ID from DIR_COMPANIES where COM_ID = '" & IdxVars.Tracking.ComId & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid ComId (DIR_COMPANIES.COM_ID): " & IdxVars.Tracking.ComId & vbCrLf
'        End If
'    End If
'
'    'BusUnit (DIR_BUSINESS_UNITS.CODE)
'    If Len(Trim(IdxVars.Tracking.BuId)) = 0 Then
'        strErr = strErr & "Invalid BuId: " & IdxVars.Tracking.BuId & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.BuId) = "NULL" Then
'        strErr = strErr & "Invalid BuId: " & IdxVars.Tracking.BuId & vbCrLf
'    Else
'        strSql = "Select CODE from DIR_BUSINESS_UNITS where CODE = '" & IdxVars.Tracking.BuId & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid BuId (DIR_BUSINESS_UNITS.CODE): " & IdxVars.Tracking.BuId & vbCrLf
'        End If
'    End If
'
'    'ReferenceId
'    If Len(Trim(IdxVars.Tracking.ReferenceId)) = 0 Then
'        strErr = strErr & "Invalid ReferenceId: " & IdxVars.Tracking.ReferenceId & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.ReferenceId) = "NULL" Then
'        strErr = strErr & "Invalid ReferenceId: " & IdxVars.Tracking.ReferenceId & vbCrLf
'    End If
'
'    'ReqSeqNum (DIR_REQUEST.REQ_SEQ_NUM)
'    'by now ReqSeqNum is mandatory
'    If Len(Trim(IdxVars.Tracking.ReqSeqNum)) = 0 Then
'        strErr = strErr & "Invalid ReqSeqNum: " & IdxVars.Tracking.ReqSeqNum & vbCrLf
'    ElseIf IdxVars.Tracking.ReqSeqNum = "NULL" Then
'        strErr = strErr & "Invalid ReqSeqNum: " & IdxVars.Tracking.ReqSeqNum & vbCrLf
'    Else
'        strSql = "Select REQ_SEQ_NUM from DIR_REQUEST where REQ_SEQ_NUM = " & IdxVars.Tracking.ReqSeqNum
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid ReqSeqNum (DIR_REQUEST.REQ_SEQ_NUM): " & IdxVars.Tracking.ReqSeqNum & vbCrLf
'        End If
'    End If
'
'    'RequestStatus  (DIR_SYSTEM_CODES.DIR_REQ_STATUS)
'    If Len(Trim(IdxVars.Tracking.RequestStatus)) = 0 Then
'        strErr = strErr & "Invalid RequestStatus: " & IdxVars.Tracking.RequestStatus & vbCrLf
'    ElseIf Trim(IdxVars.Tracking.RequestStatus) = "NULL" Then
'            strErr = strErr & "Invalid RequestStatus: " & IdxVars.Tracking.RequestStatus & vbCrLf
'    Else
'        strSql = "Select VALUE from DIR_SYSTEM_CODES where CODE = 'DIR_REQ_STATUS' and VALUE = '" & IdxVars.Tracking.RequestStatus & "'"
'        Set rsIndex = adoConn.Execute(strSql)
'        If rsIndex.RecordCount <= 0 Then
'            strErr = strErr & "Invalid RequestStatus (DIR_SYSTEM_CODES.DIR_REQ_STATUS): " & IdxVars.Tracking.RequestStatus & vbCrLf
'        End If
'    End If
'
'    '****************Requestor Vars*********************
'    'Date
'    If Len(Trim(IdxVars.Request.Date)) = 0 Then
'        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
'    ElseIf Trim(IdxVars.Request.Date) = "NULL" Then
'        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
''   IsDate doesn't work with "YYYYMMDD"?
''    ElseIf Not IsDate(IdxVars.Request.Date) Then
''        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
'    ElseIf Len(Trim(IdxVars.Request.Date)) <> 8 Then
'        strErr = strErr & "Invalid Date: " & IdxVars.Request.Date & vbCrLf
'    End If
'
'    'Email
'    If Len(Trim(IdxVars.Request.Email)) = 0 Then
'        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
'    ElseIf Trim(IdxVars.Request.Email) = "NULL" Then
'        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
'    ElseIf InStr(1, IdxVars.Request.Email, "@") = 0 Then
'        strErr = strErr & "Invalid Email: " & IdxVars.Request.Email & vbCrLf
'    End If
'
'    'Name
'    If Len(Trim(IdxVars.Request.Name)) = 0 Then
'        strErr = strErr & "Invalid Name: " & IdxVars.Request.Name & vbCrLf
'    ElseIf Trim(IdxVars.Request.Name) = "NULL" Then
'        strErr = strErr & "Invalid Name: " & IdxVars.Request.Name & vbCrLf
'    End If
'
'    'Time
'    If Len(Trim(IdxVars.Request.Time)) = 0 Then
'        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
'    ElseIf Trim(IdxVars.Request.Time) = "NULL" Then
'        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
'    ElseIf Len(Trim(IdxVars.Request.Time)) <> 6 Then
'        strErr = strErr & "Invalid Time: " & IdxVars.Request.Time & vbCrLf
'    End If
'
'    'UserId
'    If Len(Trim(IdxVars.Request.UserId)) = 0 Then
'        strErr = strErr & "Invalid UserId: " & IdxVars.Request.UserId & vbCrLf
'    ElseIf Trim(IdxVars.Request.UserId) = "NULL" Then
'        strErr = strErr & "Invalid UserId: " & IdxVars.Request.UserId & vbCrLf
'    End If
'
'    If Len(Trim(strErr)) = 0 Then
'        ValidateHeaderData = True
'    Else
'        ValidateHeaderData = False
'    End If
'
'    Exit Function
'
'ValidateHeaderDataFix:
'    ValidateHeaderData = False
'    MsgBox "ValidateHeaderData: " & Err.Number & " - " & Err.Description
'End Function
'
''Public Function UpdateInterfaceIndex() As Boolean
''
''    'Db vars
''    Dim strSql As String
''    Dim cmdAdo As ADODB.Command
''    Dim lngRecordsAffected As Long
''    Dim rsIndex As ADODB.Recordset
''
''    On Error GoTo UpdateInterfaceIndexFix
''
''
'''     'initilize the recordset
''     Set rsIndex = New ADODB.Recordset
''     rsIndex.CursorType = adOpenKeyset
''     rsIndex.LockType = adLockOptimistic
''
''
'''    strSql = "Select * from DIR_INTERFACE_INDEX"
''    'strSql = "Select * from DIR_INTERFACE_INDEX"
''    'strSql = "Select XML_STRING from DIR_INTERFACE_INDEX I, DIR_INTERFACE_XML X"
''    strSql = "Select * from DIR_INTERFACE_INDEX"
''    strSql = strSql & " where INTERFACE_NO = " & CLng(IdxVars.InterfaceNo)
''    Set rsIndex = adoConn.Execute(strSql)
''    If rsIndex.RecordCount = 1 Then
''        strSql = "Update DIR_INTERFACE_INDEX"
''        'these should already have been inserted by Johan
''        'strSql = strSql & " set COM_ID = '" & IdxVars.Tracking.ComId & "'"
''        'strSql = strSql & ", BU_ID = '" & IdxVars.Tracking.BuId & "'"
''        'strSql = strSql & ", MESSAGE_ID = '" & IdxVars.Tracking.MsgId & "'"
''        strSql = strSql & " set REFERENCE_ID = '" & IdxVars.Tracking.ReferenceId & "'"
''        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
''            If IdxVars.Tracking.ReqSeqNum <> "" Then
''                strSql = strSql & ", REQ_SEQ_NUM = " & IdxVars.Tracking.ReqSeqNum
''            End If
''        End If
''        'strSql = strSql & ", CREATED_DATE = '" & IdxVars.ComId & "'"
''        strSql = strSql & ", KEYTAX_TYPE = '" & IdxVars.KeyTaxType & "'"
''        'strSql = strSql & ", MQ_STATUS = '" & IdxVars.MqStatus & "'"
''        strSql = strSql & ", MQ_STATUS = '04'"  'Processed
''        strSql = strSql & " where INTERFACE_NO = " & CLng(IdxVars.InterfaceNo)
''
''        Set cmdAdo = New ADODB.Command
''        With cmdAdo
''            .CommandText = strSql
''            .CommandType = adCmdText
''            Set .ActiveConnection = adoConn
''            .Execute lngRecordsAffected
''        End With
''        If lngRecordsAffected = 1 Then
''            UpdateInterfaceIndex = True
''        Else
''            UpdateInterfaceIndex = False
''        End If
''    Else
''        UpdateInterfaceIndex = False
''    End If
''
''    Exit Function
''
''UpdateInterfaceIndexFix:
''    UpdateInterfaceIndex = False
''    MsgBox "UpdateInterfaceIndex: " & Err.Number & " - " & Err.Description
''End Function
'
'Public Function CreateXmlVersionDtdHeader() As String
'    Dim strXmlString As String
'
'    strXmlString = "<?xml version=""1.0"" encoding=""UTF-8""?>" & Chr(13)
'    strXmlString = strXmlString & "<!DOCTYPE KeyTax SYSTEM """ & App.Path & "\Error.dtd"">" & Chr(13)
'
'    CreateXmlVersionDtdHeader = strXmlString
'
'End Function
'Public Function CreateXmlHeader() As String
'
'    Dim xmldoc As MSXML2.DOMDocument
'
'    Dim nNode As MSXML2.IXMLDOMNode
'    Dim nChild As MSXML2.IXMLDOMNode
'    Dim nParentList As MSXML2.IXMLDOMNodeList
'    Dim nParentFoundList As MSXML2.IXMLDOMNodeList
'    Dim nParent As MSXML2.IXMLDOMNode
'    Dim eParent As MSXML2.IXMLDOMElement
'    Dim eChild As MSXML2.IXMLDOMElement
'    Dim strNewKtMsgId As String
'
'    On Error GoTo WriteXmlStringFix
'
'    Set xmldoc = New MSXML2.DOMDocument40
'
'    Set nNode = xmldoc.createNode(NODE_ELEMENT, "KeyTax", "")
'    Set xmldoc.documentElement = nNode
'
'    Set nParentList = xmldoc.getElementsByTagName("KeyTax")
'    '01 = Directive Request,02=Response,03=Cancel Directive Request,04=Cancel Directive Response,
'    '05=Decline Response,06=File Approved Response,07=Resend Directive Request,08=Status Enquiry Request,
'    '09=Status Response,10=File Error Response-->
'    '<!ATTLIST KeyTax
'    'Type CDATA #FIXED "08"
'
'    Set eParent = nParentList.Item(0)
'    IdxVars.KeyTaxType = "08"
'    Call eParent.setAttribute("Type", IdxVars.KeyTaxType)     '08=Status Enquiry Request (Fixed in FileApproved.dtd)
'
'    'KeyTax node
'    'Add 2 children nodes to the parent KeyTax
'    Set eParent = nParentList.Item(0)
'    Set eChild = xmldoc.createElement("Requestor")
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Tracking")
'    Call eParent.appendChild(eChild)
'
'    'MsgBox xmldoc.xml
'
'    'Requestor node
'    'Set nParentList = xmldoc.selectNodes("/KeyTax/Requestor/*")
'    Set nParentList = xmldoc.getElementsByTagName("Requestor")
'    Set eParent = nParentList.Item(0)
'    Set eChild = xmldoc.createElement("Date")
'    eChild.Text = IdxVars.Request.Date
'    'Call eChild.setAttribute("Name", "Name Value")
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Time")
'    eChild.Text = IdxVars.Request.Time
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Name")
'    eChild.Text = IdxVars.Request.Name
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("UserID")
'    eChild.Text = IdxVars.Request.UserId
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("email")
'    eChild.Text = IdxVars.Request.Email
'    Call eParent.appendChild(eChild)
'
'
'    'MsgBox xmldoc.xml
'
'    'Tracking node
'    'Set nParentList = xmldoc.selectNodes("/KeyTax/Requestor/*")
'    Set nParentList = xmldoc.getElementsByTagName("Tracking")
'    Set eParent = nParentList.Item(0)
'    Set eChild = xmldoc.createElement("RequestStatus")
'    'eChild.Text = IdxVars.Tracking.RequestStatus
'    'Call eChild.setAttribute("Type", "14")              'Dir_Request_Status 14 = Remote Request Loaded (Fixed in FileApproved.dtd)
'    eChild.Text = IdxVars.Tracking.NewRequestStatus
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Company")
'    eChild.Text = IdxVars.Tracking.ComId
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("BusinessUnit")
'    eChild.Text = IdxVars.Tracking.BuId
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Message")
'    If GetNextKtMessageId(strNewKtMsgId) Then
'        Call eChild.setAttribute("ID", strNewKtMsgId)
'    Else
'        Call eChild.setAttribute("ID", IdxVars.Tracking.MsgId)
'    End If
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("Reference")
'    eChild.Text = IdxVars.Tracking.ReferenceId
'    Call eParent.appendChild(eChild)
'    Set eChild = xmldoc.createElement("KeytaxRequestNumber")
'    eChild.Text = IdxVars.Tracking.ReqSeqNum
'    Call eParent.appendChild(eChild)
'
'    MsgBox xmldoc.xml
'
'    CreateXmlHeader = CStr(xmldoc.xml)
'
'    Exit Function
'
'WriteXmlStringFix:
'    MsgBox "WriteXmlString: " & Err.Number & " - " & Err.Description
'End Function
''Public Function CreateFileApproval(strXmlHeader As String, strXmlError As String) As Boolean
''
''    Dim xmldoc As MSXML2.DOMDocument40
''    Dim nlNodeList As MSXML2.IXMLDOMNodeList
''    Dim elParent As MSXML2.IXMLDOMElement
''    Dim elChild As MSXML2.IXMLDOMElement
''    Dim nNode As MSXML2.IXMLDOMNode
''
''    'Other
''    Dim i As Integer
''    Dim strXmlString As String
''
''
''    Dim nParentFoundList As MSXML2.IXMLDOMNodeList
''
''    On Error GoTo CreateFileApprovalFix
''
''    Set xmldoc = New MSXML2.DOMDocument40
''    'Get Data
''    'XMLDoc.Load ("C:\Shane\Projects\LCB\FormB\FormB_Request.xml")
''    xmldoc.loadXML (strXmlHeader)
''    Set nNode = xmldoc.selectSingleNode("KeyTax")
''    'Set nNode = xmldoc.createNode(NODE_ELEMENT, "KeyTax", "")
''    Set xmldoc.documentElement = nNode
''
'''    Set nlNodeList = xmldoc.selectNodes("/KeyTax")
'''    Set elKeyTax = nlNodeList.Item(0)
''
''    'Add ErrorList Element to KeyTax Node
''    Set nlNodeList = xmldoc.getElementsByTagName("KeyTax")
''    Set elParent = nlNodeList.Item(0)
''    Set elChild = xmldoc.createElement("ErrorList")
''    'elError.Text = IdxVars.Request.Date
''    Call elChild.setAttribute("Type", "06")               '"06" = KeyTax Process Status = File Accepted
''    Call elParent.appendChild(elChild)
''
'''    'Add Error to ErrorList
'''    Set nlNodeList = xmldoc.getElementsByTagName("ErrorList")
'''    Set elParent = nlNodeList.Item(0)
'''
'''    If ErrVars.ErrorType = "01" Then
'''
'''        Set elChild = xmldoc.createElement("Error")
'''        Call elChild.setAttribute("Type", "01")             '01 = Error Type = File Format Error
'''        Call elParent.appendChild(elChild)
'''
'''        Set nlNodeList = xmldoc.getElementsByTagName("Error")
'''        Set elParent = nlNodeList.Item(0)
'''        Set elChild = xmldoc.createElement("Code")
'''        elChild.Text = ErrVars.FormatErr.Code
'''        Call elParent.appendChild(elChild)
'''        Set elChild = xmldoc.createElement("Reason")
'''        elChild.Text = ErrVars.FormatErr.Reason
'''        Call elParent.appendChild(elChild)
'''        Set elChild = xmldoc.createElement("Text")
'''        elChild.Text = ErrVars.FormatErr.Text
'''        Call elParent.appendChild(elChild)
'''        Set elChild = xmldoc.createElement("Line")
'''        elChild.Text = ErrVars.FormatErr.Line
'''        Call elParent.appendChild(elChild)
'''    Else
'''
'''        Set elChild = xmldoc.createElement("Error")
'''        Call elChild.setAttribute("Type", "02")             '02 = Error Type = Data Validation Error
'''        elChild.Text = ErrVars.DataErr.DataErrText
'''        Call elParent.appendChild(elChild)
'''
'''
'''    End If
''
''    strXmlError = CStr(xmldoc.xml)
''
''    MsgBox xmldoc.xml
''
''    CreateFileApproval = True
''    Exit Function
''
''
''CreateFileApprovalFix:
''    CreateFileApproval = False
''    MsgBox "CreateFileApproval: " & Err.Number & " - " & Err.Description
''End Function
'Public Function InsertIntoInterfaceIndex(lngNewIntNo As Long, strNewMsgId As String) As Boolean
'
'     'Db vars
'    Dim strSql As String
'    Dim cmdAdo As ADODB.Command
'    Dim lngRecordsAffected As Long
'    Dim rsIndex As ADODB.Recordset
'
'
'    On Error GoTo InsertIntoInterfaceIndexFix
'
'        If Not GetNextKtMessageId(strNewMsgId) Then
'            InsertIntoInterfaceIndex = False
'            Exit Function
'        End If
'
'        strSql = "Insert into DIR_INTERFACE_INDEX"
'        strSql = strSql & " ("
'        strSql = strSql & " COM_ID,"
'        strSql = strSql & " BU_ID,"
'        strSql = strSql & " MESSAGE_ID,"
'        If IdxVars.Tracking.ReferenceId <> "NULL" Then
'            If IdxVars.Tracking.ReferenceId <> "" Then
'                strSql = strSql & " REFERENCE_ID,"
'            End If
'        End If
'        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
'            If IdxVars.Tracking.ReqSeqNum <> "" Then
'                strSql = strSql & " REQ_SEQ_NUM,"
'            End If
'        End If
'        strSql = strSql & " CREATED_DATE,"
'        If IdxVars.SarsResponseYn <> "NULL" Then
'            If IdxVars.SarsResponseYn <> "" Then
'                strSql = strSql & " SARS_RESPONSE_YN,"
'            End If
'        End If
'        If IdxVars.KeyTaxType <> "NULL" Then
'            If IdxVars.KeyTaxType <> "" Then
'                strSql = strSql & " KEYTAX_TYPE,"
'            End If
'        End If
'        strSql = strSql & " MQ_STATUS)"
'        strSql = strSql & " Values("
'        strSql = strSql & "'" & IdxVars.Tracking.ComId & "',"
'        strSql = strSql & "'" & IdxVars.Tracking.BuId & "',"
'        'strSql = strSql & "'" & IdxVars.Tracking.MsgId & "',"
'        strSql = strSql & "'" & strNewMsgId & "',"
'        If IdxVars.Tracking.ReferenceId <> "NULL" Then
'            If IdxVars.Tracking.ReferenceId <> "" Then
'                strSql = strSql & "'" & IdxVars.Tracking.ReferenceId & "',"
'            End If
'        End If
'        If IdxVars.Tracking.ReqSeqNum <> "NULL" Then
'            If IdxVars.Tracking.ReqSeqNum <> "" Then
'                strSql = strSql & IdxVars.Tracking.ReqSeqNum & ","
'            End If
'        End If
'        strSql = strSql & "GETDATE(),"
'        If IdxVars.SarsResponseYn <> "NULL" Then
'            If IdxVars.SarsResponseYn <> "" Then
'                strSql = strSql & "'" & IdxVars.SarsResponseYn & "',"
'            End If
'        End If
'        If IdxVars.KeyTaxType <> "NULL" Then
'            If IdxVars.KeyTaxType <> "" Then
'                strSql = strSql & "'" & IdxVars.KeyTaxType & "',"
'            End If
'        End If
'        strSql = strSql & "'00')"
'
'        'barb: start here
'
'        Set cmdAdo = New ADODB.Command
'        With cmdAdo
'            .CommandText = strSql
'            .CommandType = adCmdText
'            Set .ActiveConnection = adoConn
'            .Execute lngRecordsAffected
'        End With
'        If lngRecordsAffected = 1 Then
'            'get new interface no
'            strSql = "Select INTERFACE_NO from DIR_INTERFACE_INDEX where MESSAGE_ID = '" & strNewMsgId & "'"
'            Set rsIndex = adoConn.Execute(strSql)
'            If rsIndex.RecordCount = 1 Then
'                lngNewIntNo = rsIndex!INTERFACE_NO
'                InsertIntoInterfaceIndex = True
'            Else
'                InsertIntoInterfaceIndex = False
'            End If
'        Else
'            InsertIntoInterfaceIndex = False
'        End If
'
'        Exit Function
'
'InsertIntoInterfaceIndexFix:
'    InsertIntoInterfaceIndex = False
'    MsgBox "InsertIntoInterfaceIndex: " & Err.Number & " - " & Err.Description
'End Function
'Public Function InsertIntoInterfaceXml(lngNewIntNo As Long, strMsgId As String, strVersion As String, strDetail As String) As Boolean
'
'      'Db vars
'    Dim strSql As String
'    Dim cmdAdo As ADODB.Command
'    Dim lngRecordsAffected As Long
'
'    Dim strCompleteXml As String
'    Dim xmldoc As MSXML2.DOMDocument40
'    Dim strErrMsg As String
'
'    strCompleteXml = strVersion & strDetail
'
'    'check that file conforms with DTD
'    Set xmldoc = New MSXML2.DOMDocument40
'
'    'Validation XML Document
'    'i.e. load the source XML file into an MSXML DOMDocument object
'    xmldoc.async = False
'    'If Not XMLDoc.Load("C:\Projects\KeyTax\Xml\XmlDocs\FormB_Request.xml") Then
'    If Not xmldoc.loadXML(strCompleteXml) Then
'        xmldoc.validateOnParse = True
'        strErrMsg = strErrMsg & "Error Code:" & xmldoc.parseError.errorCode & vbCrLf
'        strErrMsg = strErrMsg & "Error Reason:" & xmldoc.parseError.reason & vbCrLf
'        strErrMsg = strErrMsg & "Error Text:" & xmldoc.parseError.srcText & vbCrLf
'        strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.Line & vbCrLf
'
'        MsgBox "InsertIntoInterfaceXml: Xml does not conform to DTD" & vbCrLf & strErrMsg
'        InsertIntoInterfaceXml = False
'        Exit Function
'    End If
'
'
'    On Error GoTo InsertIntoInterfaceXmlFix
'
'        strSql = "Insert into DIR_INTERFACE_XML"
'        strSql = strSql & " ("
'        strSql = strSql & " INTERFACE_NO,"
'        strSql = strSql & " MESSAGE_ID,"
'        strSql = strSql & " XML_STRING)"
'        strSql = strSql & " Values("
'        'get new no
'        strSql = strSql & "'" & lngNewIntNo & "',"
'        strSql = strSql & "'" & strMsgId & "',"
'        strSql = strSql & "'" & strCompleteXml & "')"
'
'        Set cmdAdo = New ADODB.Command
'        With cmdAdo
'            .CommandText = strSql
'            .CommandType = adCmdText
'            Set .ActiveConnection = adoConn
'            .Execute lngRecordsAffected
'        End With
'        If lngRecordsAffected = 1 Then
'            InsertIntoInterfaceXml = True
'        Else
'            InsertIntoInterfaceXml = False
'        End If
'
'        Exit Function
'
'InsertIntoInterfaceXmlFix:
'    InsertIntoInterfaceXml = False
'    MsgBox "InsertIntoInterfaceXml: " & Err.Number & " - " & Err.Description
'
'
'
'
'End Function
'Public Function GetNextKtMessageId(strNextVal As String) As Boolean
'
'    Dim rsSeq As ADODB.Recordset
'    Dim strSql As String
'    Dim cmdAdo As ADODB.Command
'    Dim lngRecordsAffected As Long
'    Dim strFillString As String
'    Dim strSeqNo As String
'
'    On Error GoTo GetNextKtMessageIdFix
'
'
'    'initilize the recordset
'    Set rsSeq = New ADODB.Recordset
'    rsSeq.CursorType = adOpenKeyset
'    rsSeq.LockType = adLockOptimistic
'
'    strSql = strSql & "Select LAST_VALUE from DIR_SEQUENCES where SEQ_NAME = 'DIR_KT_MSG_ID'"
'    Set rsSeq = adoConn.Execute(strSql)
'    If rsSeq.RecordCount > 0 Then
'        strSeqNo = rsSeq!LAST_VALUE
'
'        If Not IsNull(rsSeq!LAST_VALUE) Then
'            If rsSeq!LAST_VALUE = "999999" Then
'                strNextVal = "000001"
'            ElseIf rsSeq!LAST_VALUE = "" Then
'                MsgBox "DIR_KT_MSG_ID not set up in DIR_SEQUENCES"
'                GetNextKtMessageId = False
'            Else
'                If strSeqNo = 0 Then
'                    strSeqNo = 1
'                Else
'                    strSeqNo = CLng(strSeqNo) + 1
'                End If
'                strFillString = String(6, "0")
'                'strNextVal = CStr(rsSeq!LAST_VALUE + 1)
'                strNextVal = Format(CStr(strSeqNo), strFillString)
'
'                strSql = "Update DIR_SEQUENCES set LAST_VALUE = " & CLng(strNextVal) & " where SEQ_NAME = 'DIR_KT_MSG_ID'"
'                Set cmdAdo = New ADODB.Command
'                With cmdAdo
'                    .CommandText = strSql
'                    .CommandType = adCmdText
'                    Set .ActiveConnection = adoConn
'                    .Execute lngRecordsAffected
'                End With
'                If lngRecordsAffected = 1 Then
'                    GetNextKtMessageId = True
'                Else
'                    MsgBox "Couldn't update DIR_KT_MSG_ID not set up in DIR_SEQUENCES"
'                    GetNextKtMessageId = False
'                End If
'
'            End If
'        Else
'            strNextVal = "000001"
'        End If
'    Else
'        strNextVal = "000001"
'    End If
'
'    strNextVal = "KT" & strNextVal
'
'    Exit Function
'
'GetNextKtMessageIdFix:
'    GetNextKtMessageId = False
'    MsgBox "GetNextKtMessageId: " & Err.Number & " - " & Err.Description
'End Function
